Liebe Community,
ich möchte eine eine Tabelle mit einer sehr hohen Anzahl an Datensätzen wie im Beispiel folgt transponieren:
Name
|
Vorname
|
Alter
|
Geschlecht
|
2016
|
2019
|
Müller
|
Heinz
|
45
|
M
|
12
|
34
|
Meier
|
Hanna
|
23
|
W
|
45
|
9
|
Zu:
Name
|
Vorname
|
Alter
|
Geschlecht
|
Zeit
|
Anzahl
|
Müller
|
Heinz
|
45
|
M
|
2016
|
12
|
Müller
|
Heinz
|
45
|
M
|
2019
|
9
|
Meier
|
Hanna
|
23
|
W
|
2016
|
45
|
Meier
|
Hanna
|
23
|
W
|
2019
|
9
|
Bei der Komplexität meiner Originaltabelle kann ich die Funktion „Transponieren“ nicht verwenden.
Ich denke also dass meine einzige Möglichkeit ein Makro ist. Was meint ihr?
Ich habe mich daran versucht und komme leider nicht weiter:
mein Vorgehen: Ich möchte jede Zeile durchgehen und ermitteln, in wie vielen Jahresspalten Werte stehen. Die Zeile möchte ich anschließend entsprechend der ermittelten Anzahl kopieren und vervielfältigen und dann im Anschluss Jahr und Menge noch zuordnen.
Geradebin ich bei dem Versuch, die Anzahl der Werte zu zählen und die Zeile entsprechend zu vervielfältigen. Sieht jemand einen Fehler? Meine Variablen (e.g. Anzahl) sind bei Versuchen 0.
Sub Versuch1()
'Einfügen Spalte TIME, WERT (w,x)
'TIME
Columns(22).Insert shift:=xlShiftToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 22).Value = "TIME"
'WERT
Columns(23).Insert shift:=xlShiftToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 23).Value = "VALUE"
'Monat Spalte 1
'Variablen
'For Schleife geht durch die Zeilen
Dim RngU As Range, rngRow As Range
'For Schleife für einzelne Zeile
Dim StartZeile As Long
Dim EndZeile As Long
Dim StartSpalte As Long
Dim EndSpalte As Long
Dim Anzahl As Long
Dim i As Long
Dim y As Long
'For Each rngRow In RngU.Rows
StartZeile = 2
StartSpalte = 24
EndZeile = ActiveSheet.Range("J69234").End(xlUp).Row
Set RngU = Range("V1:AI" & EndZeile)
For y = 23 To 35
If Not IsEmpty(Cells(StartZeile, StartSpalte)) Then
Anzahl = Anzahl + 1
StartSpalte = StartSpalte + 1
End If
Next y
Rows(StartZeile).Copy
For i = 0 To Anzahl
ActiveCell.EntireRow.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Next i
Vielen Dank für Rückmeldungen!
Liebe Grüße, Nina
|